home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpc09905c.lha / fpc / utils / touch.pas < prev   
Pascal/Delphi Source File  |  1998-09-22  |  2KB  |  73 lines
  1. {
  2.     $Id: msg2inc.pp,v 1.3 1998/08/11 14:00:42 peter Exp $
  3.     This program is part of the Free Pascal run time library.
  4.     Copyright (c) 1998 by the Free Pascal development team
  5.  
  6.     Simple touch utility
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16. Program Touch;
  17.  
  18. Uses Dos;
  19.  
  20. procedure dofile (const s : string);
  21. var
  22.  filename: string;
  23.  DT: DateTime;
  24.  time: longint;
  25.  f : file;
  26.  Hour,Minute,Second,Sec100: word;
  27.  Year,Month,Day,DayOfWeek: word;
  28. begin
  29.   filename:=s;
  30.   assign(f,filename);
  31.   {$i-}
  32.    reset(f,1);
  33.   {$i+}
  34.   if IOResult<>0 then
  35.     begin
  36.       writeln ('IO-Error when opening :',filename,', Skipping.');
  37.       exit
  38.     end
  39.   else
  40.   begin
  41.     gettime(Hour,Minute,Second,Sec100);
  42.     getdate(Year,Month,Day,DayOfWeek);
  43.     DT.Year:=Year;
  44.     DT.Month:=Month;
  45.     DT.Day:=Day;
  46.     DT.Hour:=Hour;
  47.     DT.Min:=Minute;
  48.     DT.Sec:=Second;
  49.     packtime(DT,time);
  50.     setftime(f,time);
  51.     close(f);
  52.     WriteLn('...');
  53.   end;
  54. end;
  55.  
  56.  
  57.  
  58.  
  59. var
  60.  nrfile: integer;
  61. Begin
  62.      writeln('FPC Touch Version 1.0');
  63.      writeln('Copyright (c) 1995-98 by the Free Pascal Development Team');
  64.      writeln;
  65.      filemode:=0;
  66.      if paramcount<1 then
  67.        begin
  68.           writeln('touch <filename1> <filename2>...');
  69.           halt(1);
  70.        end;
  71.      for nrfile :=1 to paramcount do
  72.        dofile (paramstr(nrfile));
  73. end.